home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Jul / di9807rl / grayform.pas < prev    next >
Pascal/Delphi Source File  |  1998-02-24  |  4KB  |  146 lines
  1. unit GrayForm;
  2.  
  3. { Simple demonstration of Windows palettes.
  4.   Copyright ⌐ 1998 Tempest Software, Inc.
  5.  
  6.   This program displays a gray scale gradation. It shows
  7.   the basic principles of creating and using Windows palettes
  8.   in Delphi.
  9. }
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     procedure FormPaint(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure FormDestroy(Sender: TObject);
  21.     procedure FormResize(Sender: TObject);
  22.   private
  23.     NumShades: Integer;     // Number of distinct gray shades
  24.     Palette: HPalette;      // Handle of the gray scale palette
  25.     procedure WmEraseBkgnd(var Msg: TWmEraseBkgnd); message Wm_EraseBkgnd;
  26.   protected
  27.     function GetPalette: HPalette; override;
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. procedure TForm1.FormPaint(Sender: TObject);
  38. var
  39.   I: Integer;
  40.   Rect: TRect;
  41.   Top: Integer;
  42.   OldPal: HPalette;
  43. begin
  44.   // Tell Windows which palette to use when drawing the rectangles
  45.   OldPal := SelectPalette(Canvas.Handle, GetPalette, False);
  46.   try
  47.     // Fill a rectangle for each horizontal stripe. The horizontal limits
  48.     // are fixed, and update the top and bottom in the loop.
  49.     Rect.Left := 0;
  50.     Rect.Right := ClientWidth;
  51.  
  52.     // To avoid gaps in coverage, increment Top as the top of the next stripe.
  53.     Top := 0;
  54.     for I := 1 to NumShades do
  55.     begin
  56.       Canvas.Brush.Color := PaletteIndex(I - 1);
  57.       Rect.Top := Top;
  58.       // The next top is the current bottom.
  59.       Top := I * ClientHeight div NumShades;
  60.       Rect.Bottom := Top;
  61.       Canvas.FillRect(Rect);
  62.     end;
  63.   finally
  64.     // Always restore the old palette
  65.     SelectPalette(Canvas.Handle, OldPal, True);
  66.   end;
  67. end;
  68.  
  69. procedure TForm1.FormCreate(Sender: TObject);
  70. var
  71.   LogPal: PLogPalette;
  72.   Gray: Byte;
  73.   I: Integer;
  74.   BitsPerPixel: Integer;
  75. begin
  76.   // First determine the number of bits per pixel
  77.   if (GetDeviceCaps(Canvas.Handle, RasterCaps) and Rc_Palette) <> 0 then
  78.     BitsPerPixel := GetDeviceCaps(Canvas.Handle, ColorRes)
  79.   else
  80.     BitsPerPixel := GetDeviceCaps(Canvas.Handle, Planes) * GetDeviceCaps(Canvas.Handle, BitsPixel);
  81.   // Divide by 3 to get the number of distinct shades of each color
  82.   // element: red, green, blue. Then determine the number of colors.
  83.   NumShades := 1 shl (BitsPerPixel div 3);
  84.  
  85.   // Tell the user how many gray shades the program will display.
  86.   Caption := Format('%s - %d Shades', [Caption, NumShades]);
  87.  
  88.   // Allocate the logical palette. The LogPal record already has room
  89.   // for one color, so add enough memory for the remaining colors.
  90.   GetMem(LogPal, SizeOf(LogPal) + (NumShades-1)*SizeOf(TPaletteEntry));
  91.   try
  92.     LogPal.palVersion := $300; // required by Windows
  93.     LogPal.palNumEntries := NumShades;
  94.     for I := 0 to Pred(NumShades) do
  95.     begin
  96.       // Use a linear gray scale for simplicity. In a real graphics
  97.       // program, you should use a more sophisticated gray scale
  98.       // because the human eye does not respond linearly.
  99.       Gray := I * 255 div NumShades;
  100.   {$R- turn off because TLogPalette is defined stupidly}
  101.       LogPal.palPalEntry[I].peRed   := Gray;
  102.       LogPal.palPalEntry[I].peGreen := Gray;
  103.       LogPal.palPalEntry[I].peBlue  := Gray;
  104.       LogPal.palPalEntry[I].peFlags := 0;
  105.   {$R+}
  106.     end;
  107.     Palette := CreatePalette(LogPal^);
  108.     if Palette = 0 then
  109.       RaiseLastWin32Error;
  110.   finally
  111.     FreeMem(LogPal);
  112.   end;
  113. end;
  114.  
  115. // Tell Delphi about the form's palette. Delphi will automatically
  116. // select and realize the palette when Windows requires it.
  117. function TForm1.GetPalette: HPalette;
  118. begin
  119.   Result := Palette;
  120. end;
  121.  
  122. // Free the palette.
  123. procedure TForm1.FormDestroy(Sender: TObject);
  124. begin
  125.   DeleteObject(Palette);
  126.   Palette := 0;
  127. end;
  128.  
  129. // When the form changes size, make sure to repaint
  130. // the entire window. Otherwise, only the expanded part
  131. // gets redrawn, and the gradation looks wrong.
  132. procedure TForm1.FormResize(Sender: TObject);
  133. begin
  134.   Invalidate;
  135. end;
  136.  
  137. // Tell Windows not to erase the background because the
  138. // OnPaint handler will completely cover the form.
  139. // This reduces the amount of flicker when repainting.
  140. procedure TForm1.WmEraseBkgnd(var Msg: TWmEraseBkgnd);
  141. begin
  142.   Msg.Result := 1;
  143. end;
  144.  
  145. end.
  146.